home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pastutor.EXE / tutor04b.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-02  |  4KB  |  139 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor04b;
  9.  
  10. uses Memory, TutConst, Drivers, Objects, Views, Menus, App, MsgBox, Editors;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     constructor Init;
  15.     procedure DoAboutBox;
  16.     procedure HandleEvent(var Event: TEvent); virtual;
  17.     procedure InitMenuBar; virtual;
  18.     procedure InitStatusLine; virtual;
  19.     procedure NewWindow;
  20.   end;
  21.  
  22. constructor TTutorApp.Init;
  23. begin
  24.   MaxHeapSize := 8192;
  25.   EditorDialog := StdEditorDialog;
  26.   inherited Init;
  27.   DisableCommands([cmOrderWin, cmStockWin, cmSupplierWin]);
  28. end;
  29.  
  30. procedure TTutorApp.DoAboutBox;
  31. begin
  32.   MessageBox(#3'Turbo Vision Tutorial Application'#13 +
  33.     #3'Copyright 1992'#13#3'Borland International',
  34.     nil, mfInformation or mfOKButton);
  35. end;
  36.  
  37. procedure TTutorApp.HandleEvent(var Event: TEvent);
  38. var
  39.   R: TRect;
  40. begin
  41.   inherited HandleEvent(Event);
  42.   if Event.What = evCommand then
  43.   begin
  44.     case Event.Command of
  45.       cmNew:
  46.         begin
  47.           NewWindow;
  48.           ClearEvent(Event);
  49.         end;
  50.       cmOptionsVideo:
  51.         begin
  52.           SetScreenMode(ScreenMode xor smFont8x8);
  53.           ClearEvent(Event);
  54.         end;
  55.       cmAbout:
  56.         begin
  57.           DoAboutBox;
  58.           ClearEvent(Event);
  59.         end;
  60.     end;
  61.   end;
  62. end;
  63.  
  64. procedure TTutorApp.InitMenuBar;
  65. var
  66.   R: TRect;
  67. begin
  68.   GetExtent(R);
  69.   R.B.Y := R.A.Y + 1;
  70.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  71.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  72.       StdFileMenuItems(nil)),
  73.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  74.       StdEditMenuItems(
  75.       NewLine(
  76.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  77.       nil)))),
  78.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  79.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  80.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  81.       NewLine(
  82.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  83.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  84.       nil)))))),
  85.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  86.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  87.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  88.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  89.       nil)))),
  90.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  91.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  92.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  93.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  94.       NewLine(
  95.       StdWindowMenuItems(nil)))))),
  96.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  97.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  98.       nil)),
  99.     nil))))))
  100.   )));
  101. end;
  102.  
  103. procedure TTutorApp.InitStatusLine;
  104. var
  105.   R: TRect;
  106. begin
  107.   GetExtent(R);
  108.   R.A.Y := R.B.Y - 1;
  109.   New(StatusLine, Init(R,
  110.     NewStatusDef(0, $EFFF,
  111.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  112.       NewStatusKey('~F4~ New', kbF4, cmNew,
  113.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  114.       StdStatusKeys(nil)))),
  115.     NewStatusDef($F000, $FFFF,
  116.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  117.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  118.       StdStatusKeys(nil))), nil))));
  119. end;
  120.  
  121. procedure TTutorApp.NewWindow;
  122. var
  123.   R: TRect;
  124.   TheWindow: PEditWindow;
  125. begin
  126.   R.Assign(0, 0, 60, 20);
  127.   TheWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  128.   InsertWindow(TheWindow);
  129. end;
  130.  
  131. var
  132.   TutorApp: TTutorApp;
  133.  
  134. begin
  135.   TutorApp.Init;
  136.   TutorApp.Run;
  137.   TutorApp.Done;
  138. end.
  139.